home *** CD-ROM | disk | FTP | other *** search
/ Delphi Programmer's Power Pack / Delphi Volume 1.iso / s_to_z / smtpmail / mime.pas < prev    next >
Pascal/Delphi Source File  |  1996-09-15  |  4KB  |  185 lines
  1. unit Mime;
  2.  
  3. interface
  4.  
  5. uses Classes,SysUtils,Forms,Dialogs;
  6.  
  7. const
  8.   MaxChars = 57;
  9.  
  10. type
  11.  
  12.   TBinBytes = array[1..MaxChars] of byte;
  13.   TTxtBytes = array[1..2*MaxChars] of byte;
  14.   TBuffer = array[1..$FFF0] of byte;
  15.   T24Bits = array[0..8*MaxChars] of boolean;
  16.  
  17. EUUInvalidCharacter = class(Exception)
  18.   constructor Create;
  19. end;
  20.  
  21. TMIME = class
  22. private
  23.   StringList : TStringList;
  24.   Stream : TStream;
  25.   CurSection : byte;
  26.   A24Bits : T24Bits;
  27.   FOnProgress : TNotifyEvent;
  28.   FOnStart : TNotifyEvent;
  29.   FOnEnd : TNotifyEvent;
  30.   function GenerateTxtBytes(tb : TBinBytes; NumOfBytes : byte) : string;
  31.   procedure DoProgress(Sender : TObject);
  32.   procedure DoStart(Sender : TObject);
  33.   procedure DoEnd(Sender : TObject);
  34. public
  35.   Progress : Integer;
  36.   ProgressStep : Integer;
  37.   Canceled : boolean;
  38.   Table : string;
  39.   constructor Create(AStream : TStream; AStringList : TStringList);
  40.   procedure Encode;
  41.   property OnProgress : TNotifyEvent read FOnProgress
  42.                            write FOnProgress;
  43.   property OnStart : TNotifyEvent read FOnStart write FOnStart;
  44.   property OnEnd : TNotifyEvent read FOnEnd write FOnEnd;
  45. end;
  46.  
  47. function GetContentType(const FileName : string) : string;
  48. function MakeUniqueID : string;
  49.  
  50. implementation
  51.  
  52. constructor EUUInvalidCharacter.Create;
  53. begin
  54.   inherited Create('Invalid character in the input file');
  55. end;
  56.  
  57. {TMIME}
  58. constructor TMIME.Create(AStream : TStream; AStringList : TStringList);
  59. begin
  60.   inherited Create;
  61.   Stream:=AStream;
  62.   StringList:=AStringList;
  63.   ProgressStep:=10;
  64.   Table:='ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
  65.   FillChar(A24Bits,SizeOf(A24Bits),0);
  66. end;
  67.  
  68. procedure TMIME.DoProgress(Sender : TObject);
  69. begin
  70.   if Assigned(FOnProgress) then
  71.     FOnProgress(Sender);
  72. end;
  73.  
  74. procedure TMIME.DoStart(Sender : TObject);
  75. begin
  76.   if Assigned(FOnStart) then
  77.     FOnStart(Sender);
  78. end;
  79.  
  80. procedure TMIME.DoEnd(Sender : TObject);
  81. begin
  82.   if Assigned(FOnEnd) then
  83.     FOnEnd(Sender);
  84. end;
  85.  
  86. function TMIME.GenerateTxtBytes(tb : TBinBytes; NumOfBytes : byte) : string;
  87. var
  88.   i,j,k,b,m : word;
  89.   CheckSum : word;
  90.   s : string;
  91. begin
  92.   k:=0;
  93.   FillChar(A24Bits,SizeOf(T24Bits),0);
  94.   for i:=1 to MaxChars do
  95.   begin
  96.     b:=tb[i];
  97.     for j:=7 DownTo 0 do
  98.     begin
  99.       m:=1 shl j;
  100.       if (b and m = m) then
  101.         A24Bits[k]:=true;
  102.       Inc(k);
  103.     end;
  104.   end;
  105.   s:=''; k:=0; m:=4*(MaxChars div 3);
  106.   CheckSum:=0;
  107.   for i:=1 to m do
  108.   begin
  109.     b:=0;
  110.     for j:=5 DownTo 0 do
  111.     begin
  112.       if A24Bits[k] then b:= b or (1 shl j);
  113.       Inc(k);
  114.     end;
  115.     s[i]:=Table[b+1];
  116.   end;
  117.   if (NumOfBytes=MaxChars) or (NumOfBytes mod 3=0) then
  118.      s[0]:=Char(4*NumOfBytes div 3)
  119.   else
  120.   begin
  121.     s[0]:=Char(4*NumOfBytes div 3+1);
  122.     while (Length(s) mod 4)<>0 do
  123.       s:=Concat(s,'=');
  124.   end;
  125.   Result:=s;
  126. end;
  127.  
  128. procedure TMIME.Encode;
  129. var
  130.   BytesRead : word;
  131.   ABinBytes : TBinBytes;
  132.   Total : LongInt;
  133. begin
  134.   DoStart(Self);
  135.   StringList.Clear;
  136.   Progress:=0; Total:=0; Canceled:=false;
  137.   try
  138.     repeat
  139.       FillChar(ABinBytes,SizeOf(TBinBytes),0);
  140.       BytesRead:=Stream.Read(ABinBytes,MaxChars);
  141.       Inc(Total,BytesRead);
  142.       StringList.Add(GenerateTxtBytes(ABinBytes,BytesRead));
  143.       Progress:=100*Total div Stream.Size;
  144.       if Progress mod ProgressStep = 0 then
  145.          DoProgress(Self);
  146.       Application.ProcessMessages;
  147.     until (BytesRead<MaxChars) or Canceled;
  148.   finally
  149.     Progress:=100;
  150.     DoProgress(Self);
  151.     if Canceled then StringList.Clear;
  152.     DoEnd(Self);
  153.   end;
  154. end;
  155.  
  156. function GetContentType(const FileName : string) : string;
  157. var
  158.   Ext : string[4];
  159. begin
  160.   Ext:=UpperCase(ExtractFileExt(FileName));
  161.   if Ext='.AIF' then result:='audio/aiff'
  162.   else
  163.   if (Ext='.AU') or (Ext='.SND') then result:='audio/basic'
  164.   else
  165.   if Ext='.GIF' then result:='image/gif'
  166.   else
  167.   if Ext='.JPG' then result:='image/jpeg'
  168.   else
  169.   if Ext='.AVI' then result:='video/avi'
  170.   else
  171.     result:='application/octet-stream';
  172. end;
  173.  
  174. function MakeUniqueID : string;
  175. var
  176.   i : Integer;
  177. begin
  178.   Randomize;
  179.   Result:='';
  180.   for i:=1 to 8 do
  181.     Result:=Concat(Result,IntToStr(Random(9)));
  182. end;
  183.  
  184. end.
  185.